home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pascala.zip / ASSIGN8.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-06  |  6KB  |  209 lines
  1. (******************************************************)
  2. (* Alejo Alamillo          COSC 055                   *)
  3. (* SPRING 1991            04/27/91              *)
  4. (*     ASSIGNMENT # 8                                *)
  5. (******************************************************)
  6.  
  7.  
  8. (*************************************************************)
  9. (*  Several procedures for binary tree processing are        *)
  10. (*  contained in the module below.                           *)
  11. (*  This is NOT a complete module ready to link up with a    *)
  12. (*  driver program.        PRB 10/90                         *)
  13. (*************************************************************)
  14.  
  15. PROGRAM TreeMod(Input,Output);
  16.  
  17.   TYPE  DataType = Integer;
  18.         NodePointer = ^NodeRec;
  19.         NodeRec= RECORD
  20.                    Data: DataType;
  21.                    Level: 0..Maxint;
  22.                    Back,
  23.                    LeftLink,
  24.                    RightLink: NodePointer;
  25.                  END;
  26.  
  27.   VAR   Root,Current: NodePointer;
  28.         Seed: Integer;
  29.         DataIn,Val: DataType;
  30.  
  31. (***************************************************)
  32. (*  Generates a random number ( 0 <= R < 1 )       *)
  33. (*  Seed must be initialized ONCE before using     *)
  34. (***************************************************)
  35.  
  36. FUNCTION Random(VAR Seed: Integer): Real;
  37.   CONST Modulus = 65536;
  38.         Multiplier = 25173;
  39.         Increment = 13849;
  40.  
  41.   BEGIN
  42.   Seed:=((Multiplier*Seed) + Increment) MOD Modulus;
  43.   Random:= Seed/Modulus;
  44.   END;
  45. (***************************************************)
  46. (* Disposes of the nodes of an existing, unneeded  *)
  47. (* Tree.  Recursively called in postorder.        *)
  48. (***************************************************)
  49.  
  50. PROCEDURE DisposeTree(VAR CurrentNode:NodePointer);
  51.  
  52. BEGIN
  53. WITH CurrentNode^ DO
  54.   BEGIN
  55.   IF LeftLink<> nil THEN
  56.     DisposeTree(LeftLink);
  57.   IF RightLInk<> nil THEN
  58.     DisposeTree(RightLink);
  59. {  Dispose(CurrentNode);}
  60.   END;
  61. END;
  62. (***************************************************)
  63. (*  Recursively searches for node to insert DataIn *)
  64. (*  Inserts data DataIn into a tree in order       *)
  65. (***************************************************)
  66. PROCEDURE AddaNode(VAR Current: NodePointer;
  67.                            DataIn: DataType;
  68.                              CurrentLevel: Integer);
  69. BEGIN
  70. IF Current = nil THEN     (* Place is found *)
  71.   BEGIN
  72.   New(Current);
  73.   Current^.Data:= DataIn;
  74.   Current^.Level:= CurrentLevel;
  75.   Current^.LeftLink:= nil;
  76.   Current^.RightLink:= nil;
  77.   END
  78. ELSE                    (* Search farther *)
  79.   IF (DataIn < Current^.Data) THEN
  80.     AddaNode(Current^.LeftLink, DataIn, CurrentLevel+1)
  81.   ELSE                                            
  82.     AddaNode(Current^.RightLink, DataIn,CurrentLevel+1); (* Duplicate keys   *)
  83. END;                                                     (* are inserted in  *)
  84.                                                          (* original order   *)
  85. Procedure Changelevel(var Current:nodepointer);
  86.  
  87.  var left,right : nodepointer;
  88.  
  89.  Begin
  90.   IF current^.leftlink <> Nil then
  91.    Left := current^.leftlink;
  92.    Left^.level := current^.level + 1;
  93.    changelevel(left);
  94.   IF current^.rightlink <> Nil then
  95.     Right := Current^.rightlink;
  96.     right^.level := current^.level + 1;
  97.     changelevel(right);
  98.   End;
  99.  
  100.  
  101. (*********************************************************)
  102. (* Deletes an entered node from the tree and reconnects  *)
  103. (* the other nodes if the number is not on the tree      *)
  104. (* error is printed. The new or old tree is then shown   *)
  105. (*********************************************************)
  106.  
  107. PROCEDURE DisposeNode(VAR Current: NodePointer;
  108.                       Val    : DataType);
  109. VAR
  110.   Back,Temp:NodePointer;
  111.   Found    :Boolean;
  112. BEGIN
  113. Current := Root;
  114. Found := False;
  115. WHILE (Current <> NIL) AND NOT(Found) Do
  116.   IF Current^.Data = Val THEN
  117.     Found := True
  118.   ELSE
  119.     IF Current^.Data > Val THEN
  120.       Current := Current^.LeftLink
  121.     ELSE
  122.       Current := Current^.RightLink;
  123. IF Found THEN
  124.   BEGIN
  125.   Temp := Current;
  126.   IF Current^.RightLink = NIL THEN
  127.     Current := Current^.LeftLink
  128.   ELSE
  129.     IF Current^.LeftLink = NIL THEN
  130.       Current := Current^.RightLink
  131.     ELSE
  132.       BEGIN
  133.       Temp := Current^.LeftLink;
  134.       Back := Current;
  135.       WHILE Temp^.RightLink <> NIL DO
  136.         BEGIN
  137.         Back := Temp;
  138.         Temp := Temp^.RightLink;
  139.         END;
  140.       Current^.Data := Temp^.Data;
  141.       IF Back = Current THEN
  142.         Back^.LeftLink := Temp^.LeftLink
  143.       ELSE
  144.         Back^.RightLink := Temp^.LeftLink
  145.     END;
  146.     Dispose(Temp);
  147.   END
  148. ELSE
  149.   Writeln('The value was not found.');
  150.  
  151. END;
  152.  
  153.  (**************************************)
  154.  (* Sets up tree                       *)
  155.  (**************************************)
  156.   PROCEDURE FormTree(VAR Root:NodePointer);
  157.     CONST NumberofNodes = 25;
  158.     VAR I: Integer;
  159.         DataIn: DataType;
  160.   (*************************************)
  161.   (*  Currently randomly generated     *)
  162.   (*************************************)
  163.   PROCEDURE GetData(VAR DataIn: DataType);
  164.     BEGIN
  165.     DataIn:=Trunc(100*Random(Seed)+1);
  166.     Write(dataIn:3); 
  167.     END;
  168.  
  169. BEGIN (* FormTree *)
  170. Root:= nil;
  171. FOR I:= 1 TO NumberofNodes DO
  172.   BEGIN
  173.   GetData(DataIn);
  174.   AddaNode(Root, DataIn, 0);
  175.   END;
  176. END;
  177. (**********************************************)
  178. (*  ShowTree   Recursively displays a tree    *)
  179. (*             in L-R order.                  *)
  180. (**********************************************)
  181. PROCEDURE ShowTree(CurrentNode: NodePointer);
  182.  
  183. BEGIN
  184. WITH CurrentNode^ DO
  185.   BEGIN                     (* Reversed for rotated display *)
  186.   IF RightLink<> nil THEN
  187.     ShowTree(RightLink);
  188.   Writeln('   ',Data:3*(1+Level));
  189.   IF LeftLink<>nil THEN
  190.     ShowTree(LeftLink);
  191.   END;
  192. END;
  193.  
  194. BEGIN   (*************  MAIN *************)
  195.   (* Initialize *)
  196.   (* Describe *)
  197.   Write('Enter seed for the Random function: ');
  198.   Readln(Seed);  Writeln;
  199.  
  200.   FormTree(Root);
  201.   Writeln;  Writeln;  Writeln;
  202.   ShowTree(Root);
  203.   Write('Enter a number you wish to delete: ');
  204.   readln(Val);
  205.   DisposeNode(Current,Val);
  206.   showtree(root);
  207.   DisposeTree(Root);
  208. END.
  209.